home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / tk / dialog.tcl < prev    next >
Text File  |  1995-07-21  |  4KB  |  116 lines
  1. # dialog.tcl --
  2. #
  3. # This file defines the procedure tk_dialog, which creates a dialog
  4. # box containing a bitmap, a message, and one or more buttons.
  5. #
  6. # $Header: /user6/ouster/wish/library/RCS/dialog.tcl,v 1.4 93/08/16 16:59:52 ouster Exp $ SPRITE (Berkeley)
  7. #
  8. # Copyright (c) 1992-1993 The Regents of the University of California.
  9. # All rights reserved.
  10. #
  11. # Permission is hereby granted, without written agreement and without
  12. # license or royalty fees, to use, copy, modify, and distribute this
  13. # software and its documentation for any purpose, provided that the
  14. # above copyright notice and the following two paragraphs appear in
  15. # all copies of this software.
  16. #
  17. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  18. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  19. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  20. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  21. #
  22. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  23. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  24. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  25. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  26. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  27. #
  28.  
  29. #
  30. # tk_dialog:
  31. #
  32. # This procedure displays a dialog box, waits for a button in the dialog
  33. # to be invoked, then returns the index of the selected button.
  34. #
  35. # Arguments:
  36. # w -        Window to use for dialog top-level.
  37. # title -    Title to display in dialog's decorative frame.
  38. # text -    Message to display in dialog.
  39. # bitmap -    Bitmap to display in dialog (empty string means none).
  40. # default -    Index of button that is to display the default ring
  41. #        (-1 means none).
  42. # args -    One or more strings to display in buttons across the
  43. #        bottom of the dialog box.
  44.  
  45. proc tk_dialog {w title text bitmap default args} {
  46.     global tk_priv
  47.  
  48.     # 1. Create the top-level window and divide it into top
  49.     # and bottom parts.
  50.  
  51.     catch {destroy $w}
  52.     toplevel $w -class Dialog
  53.     wm title $w $title
  54.     wm iconname $w Dialog
  55.     frame $w.top -relief raised -bd 1
  56.     pack $w.top -side top -fill both
  57.     frame $w.bot -relief raised -bd 1
  58.     pack $w.bot -side bottom -fill both
  59.  
  60.     # 2. Fill the top part with bitmap and message.
  61.  
  62.     message $w.msg -width 3i -text $text \
  63.         -font -Adobe-Times-Medium-R-Normal-*-180-*
  64.     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 5m -pady 5m
  65.     if {$bitmap != ""} {
  66.     label $w.bitmap -bitmap $bitmap
  67.     pack $w.bitmap -in $w.top -side left -padx 5m -pady 5m
  68.     }
  69.  
  70.     # 3. Create a row of buttons at the bottom of the dialog.
  71.  
  72.     set i 0
  73.     foreach but $args {
  74.     button $w.button$i -text $but -command "set tk_priv(button) $i"
  75.     if {$i == $default} {
  76.         frame $w.default -relief sunken -bd 1
  77.         raise $w.button$i $w.default
  78.         pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
  79.         pack $w.button$i -in $w.default -padx 2m -pady 2m \
  80.             -ipadx 2m -ipady 1m
  81.         bind $w <Return> "$w.button$i flash; set tk_priv(button) $i"
  82.     } else {
  83.         pack $w.button$i -in $w.bot -side left -expand 1 \
  84.             -padx 3m -pady 3m -ipadx 2m -ipady 1m
  85.     }
  86.     incr i
  87.     }
  88.  
  89.     # 4. Withdraw the window, then update all the geometry information
  90.     # so we know how big it wants to be, then center the window in the
  91.     # display and de-iconify it.
  92.  
  93.     wm withdraw $w
  94.     update idletasks
  95.     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  96.         - [winfo vrootx [winfo parent $w]]]
  97.     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  98.         - [winfo vrooty [winfo parent $w]]]
  99.     wm geom $w +$x+$y
  100.     wm deiconify $w
  101.  
  102.     # 5. Set a grab and claim the focus too.
  103.  
  104.     set oldFocus [focus]
  105.     grab $w
  106.     focus $w
  107.  
  108.     # 6. Wait for the user to respond, then restore the focus and
  109.     # return the index of the selected button.
  110.  
  111.     tkwait variable tk_priv(button)
  112.     destroy $w
  113.     focus $oldFocus
  114.     return $tk_priv(button)
  115. }
  116.